# This file is part of Appartition, a lightweight and portable backup tool.
# Copyright (C) 2012-2013 Simon Grieger
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

###########################################################################
# Package: Appartition::Utilities
#
# This package provides various utility functions.
###########################################################################

package Appartition::Utilities;

use 5.006;
use strict;
use warnings;

use Carp;
use Cwd 'getcwd';

use Appartition;
use Appartition::Shell;

###########################################################################
# Group: Functions for Handling Mount Options
###########################################################################

# Function: split_mount_options
#
# Splits a comma-separated list into a list of mount options.
#
# Parameters:
#
#   opt_list - String holding a comma-separated list of mount options.
#
# Returns:
#
#   A list of mount options.
sub split_mount_options #(opt_list)
  {
    return split(',', shift);
  }

# Function: resolve_mount_option
#
# Resolves a mount option into a pair of name and value.
#
# Parameters:
#
#   opt - Mount option.
#
# Returns:
#
#   A list consisting of the option and its value. Note that the value may
#   be undef if the given mount option does not have a value.
sub resolve_mount_option #(opt)
  {
    my ($opt) = @_;
    my ($o, $v) = ($opt =~ m'^\s*([^=\s]+)(?:\s*=\s*(\S*))?\s*$'o);

    die 'Invalid mount option "' . $opt . '"' . "\n" unless (defined $o);

    return ($o, $v);
  }

# Function: get_conflicting_mount_options
#
# Finds mount options that conflict with the given one.
#
# Parameters:
#
#   opt - Mount option. This must be a bare mount option, without a value
#         and with all leading and trailing whitespace stripped. Otherwise,
#         expect undesired results. See <resolve_mount_option()>.
#
# Returns:
#
#   A list of conflicting mount options. Not all of these mount options are
#   necessarily useful. For example, if asked for mount options conflicting
#   with "ro", this function will return a list consisting of "noro", "rw",
#   and "norw". The list does include all conflicting mount options that
#   are used in real life, though.
sub get_conflicting_mount_options #(opt)
  {
    my ($opt) = @_;

    my $neg = negate_mount_option($opt);
    my @conflicting = ($neg);

    # Find the corresponding group of mount options.
    my ($group) = grep {scalar grep {$_ eq $opt or $_ eq $neg} @$_}
                       @Appartition::CONFLICTING_MOUNT_OPTIONS;

    if (defined $group) {
      foreach (@$group) {
        # Skip this entry if it is the initial option or its negation. We
        # do not want to include the option itself in its list of
        # conflicting options, and the option's negation has already been
        # added to the list.
        next if ($_ eq $opt or $_ eq $neg);

        # Add the entry and its negation.
        push(@conflicting, $_, negate_mount_option($_));
      }
    }

    return (@conflicting);
  }

# Function: negate_mount_option
#
# Negates a mount option. For example, the negation of "atime" is
# "noatime", and vice versa.
#
# Parameters:
#
#   opt - Mount option. This must be a bare mount option, without a value
#         and with all leading and trailing whitespace stripped. Otherwise,
#         expect undesired results. See <resolve_mount_option()>.
#
# Returns:
#
#   The given option's negation.
sub negate_mount_option #(opt)
  {
    my ($opt) = @_;

    # TODO: There might be non-negated mount options starting with "no". If
    # we find one, we will have to maintain a list of such options and
    # prevent them from having removed their leading "no" by mistake. For
    # now, every option starting with "no" is considered negated.

    return $opt =~ m'^no'o ? substr($opt, 2) : 'no' . $opt;
  }

###########################################################################
# Group: Functions for Handling Paths and File Names
###########################################################################

# Function: translate_path
#
# Translates a path. If a root file system has been specified on the
# command line and the path starts with a slash, the workspace directory
# (root mount point) will be prepended. Otherwise, the path will be left
# unmodified.
#
# Parameters:
#
#   path - Path.
#
# Returns:
#
#   The translated path.
sub translate_path #(path)
  {
    my ($path) = @_;

    return prepend_workspace($path)
      if (defined $Appartition::OPTION_VALUES->{'root'});
    return $path;
  }

# Function: prepend_workspace
#
# Prepends the workspace directory (root mount point) to the given path if
# it starts with a slash. If it does not, the path will be left unmodified.
#
# Parameters:
#
#   path - Path.
#
# Returns:
#
#   The path, as described above.
sub prepend_workspace #(path)
  {
    my ($path) = @_;

    return $Appartition::WORKSPACE . $path
      if ($path =~ m'^/'o);
    return $path;
  }

# Function: get_directory
#
# Returns the path to the directory where a file or directory resides. Note
# that a given relative path might be translated into an absolute one.
#
# Parameters:
#
#   path - Path to the file or directory.
#
# Returns:
#
#   The path to the directory where the given file or directory resides.
sub get_directory #(path)
  {
    my ($path) = @_;

    # We need the canonical path to avoid problems caused by "." and "..".
    my @components = split_path(get_canonical_path($path));

    if (@components == 1) {
      if ($components[0] eq '') {
        # Assume that the parent directory of "/" is "/" (it is on most
        # systems), so nothing to be done.
      }
      else {
        # The path's directory is the current working directory.
        $components[0] = '.';
      }
    }
    else {
      # Remove the last component, and that's it.
      pop(@components);
    }

    # Join the components.
    my $dir = join_path(@components);
    Appartition::Shell::show_debug_output('Directory of "' . $path . '" is "' . $dir . '"');

    return $dir;
  }

# Function: get_canonical_path
#
# Canonicalizes a path. Every "." and ".." will be eliminated. In addition,
# duplicate and trailing slashes will be removed. Any symbolic link found
# in the path will be resolved only where necessary to eliminate a
# subsequent "..". None of the path's components need to exist. Note that a
# given relative path might be translated into an absolute one if and only
# if necessary to remove every "." and "..".
#
# Parameters:
#
#   path - Path.
#
# Returns:
#
#   The canonical form of the given path.
sub get_canonical_path #(path)
  {
    my ($path) = @_;
    my @components = ();

    foreach my $component (split_path($path)) {
      if ($component eq '') {
        # Drop empty components unless it is the first one.
        push(@components, $component)
          unless (@components);
      }
      elsif ($component eq '.') {
        # Drop the component.
      }
      elsif ($component eq '..') {
        # The component references the parent directory.

        if (@components == 1 and $components[0] eq '') {
          # Assume that the parent directory of "/" is "/" (it is on most
          # systems), so drop the component.
        }
        else {
          if (@components <= 1) {
            # Prepend the current working directory.
            unshift(@components, split_path(getcwd()));
          }

          # If the last component (the one to be removed) is a symbolic
          # link, resolve it.
          if (-l (my $symlink = join_path(@components))) {
            # As read_symbolic_link() prepends the link's directory if
            # necessary and canonicalizes the result, all we have to do is
            # replace the current path with the link's value.

            @components = split_path(read_symbolic_link($symlink));
          }

          pop(@components);
        }
      }
      else {
        # Nothing special, simply add the component to the list.
        push(@components, $component);
      }
    }

    # If the list of components is empty, the given path references the
    # current working directory.
    @components = split_path(getcwd()) unless (@components);

    # Join the components.
    my $canonical_path = join_path(@components);
    Appartition::Shell::show_debug_output('Resolved path "' . $path . '" to "' . $canonical_path . '"');

    return $canonical_path;
  }

# Function: split_path
#
# Splits a path into its components. If the path is absolute (i.e., starts
# with a slash), the first component will be the empty string. Trailing
# slashes will be ignored.
#
# Parameters:
#
#   path - Path. Must not be the empty string.
#
# Returns:
#
#   A list of the path's components (one at least).
sub split_path #(path)
  {
    my ($path) = @_;
    my @components = ();

    croak 'The empty string is not a valid path'
      if ($path eq '');

    # Take care of absolute paths.
    if ($path =~ m'^/'o) {
      $path =~ s'^/''o;
      push(@components, '');
    }

    # Split the rest of the path's components.
    push(@components, split('/', $path));

    return @components;
  }

# Function: join_path
#
# Joins a list of path components into a path. To get an absolute path, the
# first component must be the empty string. Trailing slashes will be
# stripped.
#
# Parameters:
#
#   components - List of the path's components (one at least).
#
# Returns:
#
#   The path.
sub join_path #(components)
  {
    my @components = @_;
    my $path = '';

    croak 'A valid path must have at least one component'
      unless (@components);

    # Take care of absolute paths.
    if ($components[0] eq '') {
      $path = '/';
      shift(@components);
    }

    # Append the rest of the path.
    $path .= join('/', @components);

    return strip_trailing_slashes($path);
  }

# Function: strip_trailing_slashes
#
# Strips trailing slashes from the given path.
#
# Parameters:
#
#   path - Path.
#
# Returns:
#
#   The same path, with all trailing slashes removed.
sub strip_trailing_slashes #(path)
  {
    my ($path) = @_;
    chop($path) while ($path ne '/' and $path =~ m'/$'o);
    return $path;
  }

###########################################################################
# Group: Functions for Retrieving Information on Files
###########################################################################

# Function: read_symbolic_link
#
# Reads the value of a symbolic link. If the link's value is a relative
# path, automatically prepends the link's directory, so that the link
# target can be accessed from within the current working
# directory. Furthermore, the link value will be canonicalized. See
# <get_canonical_path()> for details.
#
# Parameters:
#
#   path - Path to the symbolic link.
#
# Returns:
#
#   The given symbolic link's value.
sub read_symbolic_link #(path)
  {
    my ($path) = @_;
    my $value;

    $value = readlink($path)
      or die 'Failed to read symbolic link "' . $path . '": ' . $! . "\n";

    $value = get_directory($path) . '/' . $value
      unless ($value =~ m'^/'o);

    return get_canonical_path($value);
  }

###########################################################################
# Group: Functions for Creating and Removing Files and Directories
###########################################################################

# Function: create_directory
#
# Creates a directory.
#
# Parameters:
#
#   dir - Path to the directory.
#
# Returns:
#
#   True.
sub create_directory #(dir)
  {
    my ($dir) = @_;

    mkdir($dir)
      or die 'Failed to create directory "' . $dir . '": ' . $! . "\n";

    return 1;
  }

# Function: create_directory_with_parents
#
# Creates a directory and all parent directories as needed.
#
# Parameters:
#
#   dir - Path to the directory.
#
# Returns:
#
#   True.
sub create_directory_with_parents #(dir)
  {
    my ($dir) = @_;

    # TODO

    return 1;
  }

# Function: remove_directory
#
# Removes a directory. This function will fail if the directory to be
# removed is not empty. Use <remove_directory_recursively()> to remove a
# directory and all of its contents.
#
# Parameters:
#
#   dir - Path to the directory.
#
# Returns:
#
#   True.
sub remove_directory #(dir)
  {
    my ($dir) = @_;

    rmdir($dir)
      or die 'Failed to remove directory "' . $dir . '": ' . $! . "\n";

    return 1;
  }

###########################################################################
# Group: String Utility Functions
###########################################################################

# Function: strip_all_whitespace
#
# Removes all whitespace from a string.
#
# Parameters:
#
#   str - String.
#
# Returns:
#
#   The string with all whitespace stripped.
sub strip_all_whitespace #(str)
  {
    my ($str) = @_;

    $str =~ s'\s+''og;
    return $str;
  }

1;
